;;;;; A simple example to verify the correctness of the SDL, OpenRM and ODE FLI definitions for Lispworks.
;;;;; Author: Luke J Crook, luke@balooga.com
;;;;; 

(in-package #:rm-examples)

(defun ball ()
  (sdl:with-init ()
    (sdl:window 320 240 :flags sdl:sdl-opengl)
    (setf (sdl:frame-rate) 30)
    (rm:with-init ()
      (rm::attach-root-node (rm:new-node :opacity :rm-renderpass-opaque))
      (let* ((window (make-instance 'rm:window
				    :pipe (rm:new-pipe (sdl:width sdl:*default-display*)
						       (sdl:height sdl:*default-display*)
						       (sdl:get-native-window))))
	     (scene (make-instance 'rm:scene
				   :node (rm::root-node)
				   :width (rm:width window)
				   :height (rm:height window))))
	
	(rm::set-current window)
	(setf (rm::background-color window) (rm::color-4d 0.5 1.0 0.0 0.0))

	(rm:add-scene window scene)

	(rm::with-default-node ((rm::root-node))
	  (rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	    (dotimes (x 5)
	      (dotimes (y 5)
		(rm::with-default-primitive ((make-instance 'rm::sphere-primitive))
		  (rm::set-rgb/a (rm::color-4d (random 1.0) (random 1.0) (random 1.0) (random 1.0)))
		  (rm::set-tesselate 128)
		  (rm::set-radius 5.0)
		  (rm::set-xy/z (rm::vertex-3d (* x 10.0) (* y 10.0) 0.0)))))
	    (rm::set-compute-bounding-box)
	    (rm::set-union-all-boxes)
	    (rm::set-compute-center-from-bounding-box)))
		    	
	(rm:set-defaults window)
	
	(sdl::with-events ()
	  (:quit-event () t)
	  (:key-down-event (:key key)
			   (when (equal key :sdl-key-escape)
			     (sdl::push-quit-event)))
	  (:idle ()
		 (rm:render window)
		 (sdl:update-display)))
	(rm::delete-scene-graph)))))

(defun ball ()
  (sdl:with-init ()
    (sdl:window 320 240 :flags sdl:sdl-opengl)
    (setf (sdl:frame-rate) 30)
    (rm:with-init ()
      (rm::attach-root-node (rm:new-node :opacity :rm-renderpass-opaque))
      (let* ((window (make-instance 'rm:window
				    :pipe (rm:new-pipe (sdl:width sdl:*default-display*)
						       (sdl:height sdl:*default-display*)
						       (sdl:get-native-window))))
	     (scene (make-instance 'rm:scene
				   :node (rm::root-node)
				   :width (rm:width window)
				   :height (rm:height window))))
	
	(rm::set-current window)
	(setf (rm::background-color window) (rm::color-4d 0.5 1.0 0.0 0.0))

	(rm:add-scene window scene)

	(rm::with-default-node ((rm::root-node))
	  (rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	    (rm::with-default-primitive ((make-instance 'rm::sphere-primitive))
	      (rm::set-rgb/a (rm::color-4d (random 1.0) (random 1.0) (random 1.0) (random 1.0)))
	      (rm::set-tesselate 128)
	      (rm::set-radius 5.0)
	      (rm::set-xy/z (rm::vertex-3d 0.0 0.0 0.0)))
	    (rm::set-compute-bounding-box))
	  (rm::set-union-all-boxes)
	  (rm::set-compute-center-from-bounding-box))
		    	
	(rm:set-defaults window)
	
	(sdl::with-events ()
	  (:quit-event () t)
	  (:key-down-event (:key key) (when (equal key :sdl-key-escape)	(sdl:push-quit-event)))
	  (:idle ()
		 (rm:render window)
		 (sdl:update-display)))
	(rm::reset-scene-graph)))))

(defun cone ()
  (sdl:with-init ()
    (sdl:window 320 240 :flags sdl:sdl-opengl)
    (setf (sdl:frame-rate) 30)
    (rm:with-init ()
      (setf (rm:current-window) (make-instance 'rm:window
					       :pipe (rm:new-pipe (sdl:width sdl:*default-display*)
								  (sdl:height sdl:*default-display*)
								  (sdl:get-native-window))))
      (rm::set-current (rm:current-window))
      (rm:add-scene (rm:current-window) (make-instance 'rm:scene
						       :node (rm:rm-root-node)
						       :width (rm:width (rm:current-window))
						       :height (rm:height (rm:current-window))))
      (rm::attach-root-node (rm:new-node :opacity :rm-renderpass-opaque))
      (rm::with-default-node ((rm::root-node))
	(rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	  (let ((bounds nil))
	    (rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	      (rm::with-default-primitive ((make-instance 'rm::cone-primitive))
		(rm::set-rgb/a (rm::color-4d (random 1.0) (random 1.0) (random 1.0) (random 1.0)))
		(rm::set-tesselate 32)
		(rm::set-xy/z (list (rm::vertex-3d 1.0 0.0 0.0) (rm::vertex-3d 0.0 0.0 0.0)))
		(rm::set-compute-bounding-box)
		(setf bounds (rm::get-bounding-box)))
	      (rm::set-compute-bounding-box))
	    (rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	      (rm::with-default-primitive ((make-instance 'rm::box-wire-primitive))
		(rm::set-xy/z bounds)
		(rm::set-compute-bounding-box))
	      (rm::set-compute-bounding-box)
	      (rm::set-compute-center-from-bounding-box)))
	  (rm::set-compute-bounding-box)
	  (rm::set-compute-center-from-bounding-box))
	(rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	  (let ((bounds nil))
	    (rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	      (rm::with-default-primitive ((make-instance 'rm::sphere-primitive))
;; 		(rm::set-xy/z (rm::vertex-3d 2.0 0.0 0.0))
;; 		(rm::set-rgb/a (rm::color-4d (random 1.0) (random 1.0) (random 1.0) (random 1.0)))
;; 		(rm::set-tesselate 128)
;; 		(rm::set-radius 30.0)
		(rm::set-compute-bounding-box)
		(setf bounds (rm::get-bounding-box)))
	      (rm::set-compute-bounding-box)
	      (rm::set-compute-center-from-bounding-box))
	    (rm::with-default-node ((rm:new-node :opacity :rm-renderpass-opaque))
	      (rm::with-default-primitive ((make-instance 'rm::box-wire-primitive))
		(rm::set-xy/z bounds)
		(rm::set-compute-bounding-box))
	      (rm::set-compute-bounding-box)
	      (rm::set-compute-center-from-bounding-box)))
	  (rm::set-compute-bounding-box)
	  (rm::set-compute-center-from-bounding-box))
	(rm::set-compute-bounding-box)
	(rm::set-union-all-boxes)
	(rm::set-compute-center-from-bounding-box))
	    
      (setf (rm::background-color (rm:current-window)) (rm::color-4d 0.5 1.0 0.0 0.0))
      (rm:set-defaults (rm:current-window))
      (sdl::with-events ()
	(:quit-event () t)
	(:key-down-event (:key key)
			 (when (equal key :sdl-key-escape)
			   (sdl::push-quit-event)))
	(:idle ()
	       (rm:render (rm:current-window))
	       (sdl:update-display)))
      (rm::reset-scene-graph))))




